home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN1.LZH / KURV2.FOR < prev    next >
Text File  |  1988-02-08  |  3KB  |  98 lines

  1.       SUBROUTINE KURV2 ( T, XS, YS, N, X, Y, XP, YP, S, SIGMA )
  2. C*
  3. C*               *********************************************
  4. C*               *                                           *
  5. C*               *                    KURV2                  *
  6. C*               *                                           *
  7. C*               *********************************************
  8. C*
  9. C*      KURV2 - EVALUATE THE INTERMEDIATE POINTS FOR THE CURVE
  10. C*           DETERMINED BY ROUTINE KURV1.
  11. C*
  12. C*      AUTHOR - A. K. CLINE
  13. C*               NATIONAL CENTER FOR ATMOSPHERIC RESEARCH
  14. C*               PO BOX 1470
  15. C*               BOULDER, COLORADO   80302
  16. C*
  17. C*      CODED BY - A. E. RAGOSTA     415-694-6235
  18. C*               TR18
  19. C*               AMES RSCH CTR
  20. C*               MOFFETT FIELD, CALIF  94035
  21. C*
  22. C*      INPUT ARGUMENTS
  23. C*           T      - LOCATION ON CURVE NORMALIZED FROM 0. TO 1.
  24. C*           N      - NUMBER OF POINTS IN ARRAYS
  25. C*           X      - INDEPENDENT VALUES ARRAY
  26. C*           Y      - DEPENDENT VALUES ARRAY
  27. C*           XP     - INFORMATION PASSED FROM KURV1
  28. C*           YP     - INFORMATION PASSED FROM KURV1
  29. C*           SIGMA  - TENSION FACTOR
  30. C*
  31. C*      OUTPUT ARGUMENTS
  32. C*           XS     - CALCULATED X VALUE FOR T
  33. C*           YS     - CALCULATED Y VALUE FOR T
  34. C*
  35. C*      COMMON BLOCKS REFERENCED :
  36. C*           NONE
  37. C*
  38. C*      FILES REFERENCED :
  39. C*           NONE
  40. C*
  41. C*     EXTERNAL SUBPROGRAMS REFERENCED :
  42. C*          SQRT, EXP, ABS, FLOAT
  43. C*
  44. C*      VERSION I      29 DEC 1981
  45. C*
  46. C***********************************************************************
  47. C*
  48.       DIMENSION X(N), Y(N), XP(N), YP(N)
  49. C
  50.       SIGMAP = ABS ( SIGMA ) * FLOAT (N-1) / S
  51.       TN     = ABS ( T * S )
  52. C
  53. C --- IF T < 0 CONTINUE FROM LAST POINT
  54. C
  55.       IF ( T .LT. 0. ) GO TO 10
  56.       I1   = 2
  57.       XS   = X(1)
  58.       YS   = Y(1)
  59.       SUM  = 0.
  60.       IF ( T .LE. 0 ) RETURN
  61. C
  62. C --- DETERMINE WHICH SEGMENT WE ARE IN
  63. C
  64.    10 DO 30 I = I1, N
  65.          DELX = X(I) - X(I-1)
  66.          DELY = Y(I) - Y(I-1)
  67.          DELS = SQRT ( DELX**2 + DELY**2 )
  68.          IF (( SUM + DELS - TN ) .GE. 0. ) GO TO 40
  69.          SUM  = SUM + DELS
  70.    30    CONTINUE
  71. C
  72. C --- IF T > 1, RETURN LAST POINT IN ARRAY
  73. C
  74.       XS = X(N)
  75.       YS = Y(N)
  76.       RETURN
  77. C
  78. C --- INTERPOLATION
  79. C
  80.    40 DEL1   = TN - SUM
  81.       DEL2   = DELS - DEL1
  82.       EXPS1  = EXP ( SIGMAP * DEL1 )
  83.       SINHD1 = .5 * ( EXPS1 - 1./EXPS1 )
  84.       EXPS   = EXP ( SIGMAP * DEL2 )
  85.       SINHD2 = .5 * ( EXPS - 1./EXPS )
  86.       EXPS   = EXPS1 * EXPS
  87.       SINHS  = .5 * ( EXPS - 1./EXPS )
  88.       XS     = ( XP(I) * SINHD1 + XP(I-1) * SINHD2 ) / SINHS +
  89.      $ (( X(I) - XP(I)) * DEL1 + ( X(I-1) - XP(I-1)) * DEL2 ) / DELS
  90.       YS     = ( YP(I) * SINHD1 + YP(I-1) * SINHD2 ) / SINHS +
  91.      $ (( Y(I) - YP(I)) * DEL1 + ( Y(I-1) - YP(I-1)) * DEL2 ) / DELS
  92.       I1     = I
  93.       RETURN
  94.       END
  95. C
  96. C---END KURV2
  97. C
  98.